home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue28 / tiptrix / LISTING1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-11-11  |  3.7 KB  |  142 lines
  1. unit IntfList;
  2. interface
  3. uses
  4.   Classes;
  5. type
  6.   IInterfaceList = interface['{BEC6B350-40CF-11D1-91D9-00C0DF119781}']
  7.     // property implementation methods
  8.     function  GetCount: integer;
  9.     function  GetItem(Index: integer):IUnknown;
  10.     procedure SetItem(Index: integer; const Value: IUnknown);
  11.     // methods
  12.     procedure Add(const Unknown: IUnknown);
  13.     procedure Clear;
  14.     procedure Delete(Index: integer);
  15.     procedure Exchange(Index1,Index2: integer);
  16.     function  IndexOf(const Unknown: IUnknown): integer;
  17.     procedure Insert(Index: integer; const Unknown: IUnknown);
  18.     procedure Move(CurIndex,NewIndex: integer);
  19.     procedure Pack;
  20.     procedure Remove(const Unknown: IUnknown);
  21.     // properties
  22.     property  Count: integer read GetCount;
  23.     property  Items[Index: integer]: IUnknown read GetItem write SetItem; default;
  24.   end;
  25.   TInterfaceList = class(TInterfacedObject,IInterfaceList)
  26.   private
  27.     fItems: TList;
  28.   protected
  29.     function  GetCount: integer; virtual;
  30.     function  GetItem(Index: integer): IUnknown; virtual;
  31.     procedure SetItem(Index: integer; const Value: IUnknown); virtual;
  32.   public
  33.     constructor Create;
  34.     destructor Destroy; override;
  35.     procedure Add(const Unknown: IUnknown);
  36.     procedure Clear;
  37.     procedure Delete(Index: integer);
  38.     procedure Exchange(Index1,Index2: integer);
  39.     function  IndexOf(const Unknown: IUnknown): integer;
  40.     procedure Insert(Index: integer; const Unknown: IUnknown);
  41.     procedure Move(CurIndex,NewIndex: integer);
  42.     procedure Pack;
  43.     procedure Remove(const Unknown: IUnknown);
  44.     property  Count: integer read GetCount;
  45.     property  Items[Index: integer]: IUnknown read GetItem write SetItem; default;
  46.   end;
  47.  
  48. implementation
  49. constructor TInterfaceList.Create;
  50. begin
  51.   inherited Create;
  52.   FItems:= TList.Create;
  53. end;
  54.  
  55. destructor TInterfaceList.Destroy;
  56. begin
  57.   Clear;
  58.   FItems.Free;
  59.   inherited Destroy;
  60. end;
  61.  
  62. function  TInterfaceList.GetCount: integer;
  63. begin
  64.   Result:= FItems.Count;
  65. end;
  66.  
  67. function  TInterfaceList.GetItem(Index: integer): IUnknown;
  68. begin
  69.   Result:= IUnknown(FItems[Index]);
  70. end;
  71.  
  72. procedure TInterfaceList.SetItem(Index: integer; const Value: IUnknown);
  73. var
  74.   Unknown: IUnknown;
  75. begin
  76.   Unknown:= IUnknown(FItems[Index]);
  77.   if Assigned(Unknown) then Unknown._Release;
  78.   FItems[Index]:= pointer(Value);
  79.   if Assigned(Value) then Value._AddRef;
  80. end;
  81.  
  82. procedure TInterfaceList.Add(const Unknown: IUnknown);
  83. begin
  84.   FItems.Add(pointer(Unknown));
  85.   if Assigned(Unknown) then Unknown._AddRef;
  86. end;
  87.  
  88. procedure TInterfaceList.Insert(Index: integer; const Unknown: IUnknown);
  89. begin
  90.   FItems.Insert(Index,pointer(Unknown));
  91.   if Assigned(Unknown) then Unknown._AddRef;
  92. end;
  93.  
  94. procedure TInterfaceList.Delete(Index: integer);
  95. var Unknown: IUnknown;
  96. begin
  97.   Unknown:= IUnknown(FItems[Index]);
  98.   if Assigned(Unknown) then Unknown._Release;
  99.   FItems.Delete(Index);
  100. end;
  101.  
  102. function  TInterfaceList.IndexOf(const Unknown: IUnknown): integer;
  103. begin
  104.   Result:= FItems.IndexOf(pointer(Unknown));
  105. end;
  106.  
  107. procedure TInterfaceList.Move(CurIndex,NewIndex: integer);
  108. begin
  109.   FItems.Move(CurIndex,NewIndex);
  110. end;
  111.  
  112. procedure TInterfaceList.Pack;
  113. begin
  114.   FItems.Pack;
  115. end;
  116.  
  117. procedure TInterfaceList.Remove(const Unknown: IUnknown);
  118. var
  119.   Index: integer;
  120. begin
  121.   Index:= FItems.IndexOf(pointer(Unknown));
  122.   if Index >= 0 then Delete(Index);
  123. end;
  124.  
  125. procedure TInterfaceList.Clear;
  126. var
  127.   ix: integer;
  128.   Item: pointer;
  129. begin
  130.   for ix := FItems.Count-1 downto 0 do begin
  131.     Item:= FItems[ix];
  132.     if Assigned(Item) then IUnknown(Item)._Release;
  133.   end;
  134.   FItems.Clear;
  135. end;
  136.  
  137. procedure TInterfaceList.Exchange(Index1,Index2: integer);
  138. begin
  139.   FItems.Exchange(Index1,Index2);
  140. end;
  141. end.
  142.